#!/bin/env perl

# MDF 3.x

use strict;
use warnings;
use v5.14;

package AsamMDF 3.00;

my $byte_order = 0;    # 0 little-endian, 1 bit-endian

# Identification Block
sub ID_block_parse {
    my $bit_array = shift @_;                         # 64 bytes
    my @x         = unpack( "A8A8A8n", $bit_array )
      or die "Unable to parse ID Block: $!";
    if ( $x[3] ) {
        @x = unpack( "A8A8A8nnnnA2A26nn", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A8A8A8vvvvA2A26vv", $bit_array );    # 0, LE
    }
    my $idblk = {                                          # ref
        "file_id"        => $x[0],
        "format_id"      => $x[1],
        "program_id"     => $x[2],
        "byte_order"     => $x[3],
        "float_format"   => $x[4],
        "version_number" => $x[5],
        "code_page"      => $x[6]
    };

    $byte_order = $x[3];                                   # GLOBAL
    return $idblk;
}

# except IDBLOCK
sub block_header_parse {
    my $bit_array = shift @_;                              # 4 bytes
    my @x;
    if ($byte_order) {
        @x = unpack( "A2n", $bit_array );                  # 1, BE
    }
    else {
        @x = unpack( "A2v", $bit_array );                  # 0, LE
    }
    return @x;
}

# Header Block
sub HD_block_parse {
    my $bit_array = shift @_;
    my $blkl      = length $bit_array;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nNNNnA10A8A32A32A32A32Q>s>nA32", $bit_array );   # 1, BE
    }
    else {
        @x = unpack( "A2vVVVvA10A8A32A32A32A32Q<s<vA32", $bit_array );   # 0, LE
    }
    my $hdblk = {
        "blkid"     => $x[0],
        "blksz"     => $x[1],
        "ptr_dgblk" => $x[2],
        "ptr_txblk" => $x[3],
        "ptr_prblk" => $x[4],
        "n_DGs"     => $x[5],    # number of data groups
        "date"      => $x[6],    # DD:MM:YYYY
        "time"      => $x[7],    # hh:mm:ss
        "author"    => $x[8],
        "org"       => $x[9],
        "project"   => $x[10],
        "subject"   => $x[11],
        "timestamp" => $x[12]
        ,    # local time in nanoseconds, since 00:00:00 01.01.1970
        "tz"           => $x[13],    # in hours, compare with UTC-0
        "time_quality" => $x[14],    # poor(local) 0 - 10 - 16 good(remote abs)
        "time_source"  => $x[15]
    };
    return $hdblk;
}

# Text Block
sub TX_block_parse {
    my $bit_array = shift @_;
    my $blkl      = length $bit_array;
    my $textl     = $blkl - 4;
    my @x;
    if ($byte_order) {
        @x = unpack( "A2na$textl", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2va$textl", $bit_array );    # 0, LE
    }
    my $txblk = {
        "blkid" => $x[0],
        "blksz" => $x[1],
        "text"  => $x[2]
    };
    return $txblk;
}

# Program-Specific Block
sub PR_block_parse {
    my $bit_array = shift @_;
    return TX_block_parse($bit_array);
}

#  Trigger Block
sub TR_block_parse {
    my $bit_array = shift @_;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nNnd>*", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2vVvd<*", $bit_array );    # 0, LE
    }
    my $trblk = {
        "blkid"          => $x[0],
        "blksz"          => $x[1],
        "ptr_tr_comment" => $x[2],
        "n_tr_events"    => $x[3],

        # event:
        # REAL(1) Trigger time [s] of trigger event 1
        # REAL(1) TPre trigger time [s] of trigger event 1
        # REAL(1) TPost trigger time [s] of trigger event 1
        "events" => $x[ 4 .. $#x ]
    };
    return $trblk;
}

# Data Group Block
sub DG_block_parse {
    my $bit_array = shift @_;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nNNNNnnN", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2vVVVVvvV", $bit_array );    # 0, LE
    }

    # for(@x) {
    #     print "$_\n";
    # }
    # print "\n";
    my $dgblk = {
        "blkid"           => $x[0],
        "blksz"           => $x[1],
        "ptr_next_dgblk"  => $x[2],
        "ptr_first_cgblk" => $x[3],
        "ptr_trblk"       => $x[4],
        "ptr_dtblk"       => $x[5],
        "n_cgs"           => $x[6],
        "record_id_type"  => $x[7],    # record ID type, NOT number
    };
    return $dgblk;
}

# Channel Group Block
sub CG_block_parse {
    my $bit_array = shift @_;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nNNNnnnNN", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2vVVVvvvVV", $bit_array );    # 0, LE
    }

    my $cgblk = {
        "blkid"             => $x[0],
        "blksz"             => $x[1],
        "ptr_next_cgblk"    => $x[2],
        "ptr_first_cnblk"   => $x[3],
        "ptr_txblk_comment" => $x[4],
        "record_id"         => $x[5],
        "n_cns"             => $x[6],                # number of channels
        "sz_data_record"    => $x[7],                # bytes
        "n_records"         => $x[8],
        "ptr_first_srblk"   => $x[9]
    };

    # print %{$cgblk};
    # print "\n";
    return $cgblk;
}

# Channel Block
sub CN_block_parse {
    my $bit_array = shift @_;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nNNNNNnA32A128nnnnd>d>d>NNn", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2vVVVVVvA32A128vvvvd<d<d<VVv", $bit_array );    # 0, LE
    }

    # for(@x) {
    #     print "$_\n";
    # }
    # print "\n";
    my $cnblk = {
        "blkid"                  => $x[0],
        "blksz"                  => $x[1],
        "ptr_next_cnblk"         => $x[2],
        "ptr_ccblk"              => $x[3],
        "ptr_ceblk"              => $x[4],
        "ptr_cdblk"              => $x[5],
        "ptr_txblk_comment"      => $x[6],
        "channel_type"           => $x[7],
        "signal_name"            => $x[8],
        "signal_dscrptn"         => $x[9],
        "bit_offset"             => $x[10],
        "n_bits"                 => $x[11],
        "signal_data_type"       => $x[12],
        "value_range?"           => $x[13],
        "min_value"              => $x[14],
        "max_value"              => $x[15],
        "sampling_rate"          => $x[16],
        "ptr_txblk_long_name"    => $x[17],
        "ptr_txblk_display_name" => $x[18],
        "byte_offset"            => $x[19]
    };

    # print %{$cnblk};
    # print "\n";
    return $cnblk;
}

sub Conversion_formula {
    my $ccblk = shift @_;
    my %ccblk = %{$ccblk};

    my $conversion_type = $ccblk{"conversion_type"};
    my $n_params        = $ccblk{"n_params"};
    my @params          = @{ $ccblk{"params"} };

    my $formula;

    # print $conversion_type, $n_params, @params;
    # print "\n";
    if ( $conversion_type eq 0 ) {
        $formula = sub { return $_[0] * $params[1] + $params[0]; };

        # $formula = sub { return ($_[0] - $params[0]) / $params[1] ; };
    }
    elsif ( $conversion_type eq 6 ) {
        $formula = sub {
            return ( $params[1] -
                  ( $params[3] * ( $_[0] - $params[4] - $params[5] ) ) ) /
              ( $params[2] * ( $_[0] - $params[4] - $params[5] ) - $params[0] );
        };
    }
    elsif ( $conversion_type eq 7 ) {
        $params[3] eq 0
          ? $formula = sub {
            return
              log( ( ( $_[0] - $params[6] ) * $params[5] - $params[2] ) /
                  $params[0] ) /
              $params[1];
          }
          : $params[0] eq 0 ? $formula = sub {
            return
              log( ( ( $params[2] / ( $_[0] - $params[6] ) ) - $params[5] ) /
                  $params[3] ) /
              $params[4];
          }
          : print STDERR "Unkown CC block Exponential formula: " . @params;
    }
    elsif ( $conversion_type eq 8 ) {
        ...;
    }
    elsif ( $conversion_type eq 11 ) {
        $formula = sub { my %vatb = @params; return $vatb{$_}; };
    }
    elsif ( $conversion_type eq 65535 ) {
        $formula = sub { return $_[0]; };
    }
    else {
        print STDERR "Unkown CC block conversion_type: " . $conversion_type;
    }
    return $formula;
}

# CC Channel Conversion Block
sub CC_block_parse {
    my $bit_array = shift @_;
    my $blkl      = length $bit_array;

    my @x;
    if ($byte_order) {
        @x = unpack( "A2nnd>d>A20nn", $bit_array );    # 1, BE
    }
    else {
        @x = unpack( "A2vvd<d<A20vv", $bit_array );    # 0, LE
    }

    my $ccblk = {
        "blkid"           => $x[0],
        "blksz"           => $x[1],
        "value_range?"    => $x[2],                    # physical signal value
        "min_value"       => $x[3],
        "max_value"       => $x[4],
        "unit"            => $x[5],
        "conversion_type" => $x[6],
        "n_params"        => $x[7]
    };

    # print ${$ccblk}{"conversion_type"};
    # print "\n";
    if ( grep { $_ eq ${$ccblk}{"conversion_type"} } ( 0, 6, 7, 8, 9 ) ) {

        # print ${$ccblk}{"conversion_type"};
        if ($byte_order) {
            @x = unpack( "A2nnd>d>A20nn" . ( "d>" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 1, BE
        }
        else {
            @x = unpack( "A2vvd<d<A20vv" . ( "d<" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 0, LE
        }

        ${$ccblk}{"params"} =
          [ @x[ 8 .. $#x ] ];    # ref, @{ ${$ccblk}{"params"} }
    }
    elsif ( grep { $_ eq ${$ccblk}{"conversion_type"} } ( 1, 2 ) ) {
        if ($byte_order) {
            @x = unpack(
                "A2nnd>d>A20nn" . ( "d>" x ( ${$ccblk}{"n_params"} * 2 ) ),
                $bit_array );    # 1, BE
        }
        else {
            @x = unpack(
                "A2vvd<d<A20vv" . ( "d<" x ( ${$ccblk}{"n_params"} * 2 ) ),
                $bit_array );    # 0, LE
        }
        ${$ccblk}{"params"} =
          [ @x[ 8 .. $#x ] ];    # ref, @{ ${$ccblk}{"params"} }
    }
    elsif ( 11 eq ${$ccblk}{"conversion_type"} ) {
        if ($byte_order) {
            @x = unpack( "A2nnd>d>A20nn" . ( "d>A32" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 1, BE
        }
        else {
            @x = unpack( "A2vvd<d<A20vv" . ( "d<A32" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 0, LE
        }

        ${$ccblk}{"params"} =
          [ @x[ 8 .. $#x ] ];    # ref, @{ ${$ccblk}{"params"} }
    }
    elsif ( 12 eq ${$ccblk}{"conversion_type"} ) {
        if ($byte_order) {
            @x = unpack( "A2nnd>d>A20nn" . ( "d>d>N" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 1, BE
        }
        else {
            @x = unpack( "A2vvd<d<A20vv" . ( "d<d<V" x ${$ccblk}{"n_params"} ),
                $bit_array );    # 0, LE
        }
        ${$ccblk}{"params"} =
          [ @x[ 8 .. $#x ] ];    # ref, @{ ${$ccblk}{"params"} }
                                 # print @{ ${$ccblk}{"params"} };
                                 # print "\n";
    }
    elsif ( 10 eq ${$ccblk}{"conversion_type"} ) {
        @x =
          unpack( "A2nnd>d>A20nn" . "A" . ${$ccblk}{"n_params"}, $bit_array );
        ${$ccblk}{"params"} =
          [ @x[ 8 .. $#x ] ];    # ref, @{ ${$ccblk}{"params"} }
                                 # print @{ ${$ccblk}{"params"} };
                                 # print "\n";
    }
    elsif ( 132 eq ${$ccblk}{"conversion_type"} ) {
        ...;
    }
    elsif ( 133 eq ${$ccblk}{"conversion_type"} ) {
        ...;
    }
    elsif ( 65535 eq ${$ccblk}{"conversion_type"} ) {
        ${$ccblk}{"params"} = [ () ];
    }
    else {
        print STDERR "Unkown CC block conversion_type: "
          . ${$ccblk}{"conversion_type"};
    }

    $$ccblk{"formula"} = Conversion_formula($ccblk);

    # print %{$ccblk};print "!\n";

    # print "\n";
    return $ccblk;
}

sub join_byte_number {    # BE
    my @num_byte_list = @{ shift @_ };
    my $num           = 0;
    foreach $_ (@num_byte_list) {
        $num = ( $num << 8 ) | $_;
    }
    return $num;
}

sub ceil {
    my $n = shift;
    int($n) eq $n
      ? return $n
      : return int( $n + 1 );
}

sub split_record_by_cn {
    my ( $cnblk, $record ) = @_;
    my %cnblk  = %$cnblk;
    my @record = @$record;

    my $start_byte =
      int( $cnblk{"byte_offset"} + $cnblk{"bit_offset"} / 8 );
    my $length_byte =
      ceil( ( $cnblk{"n_bits"} + $cnblk{"bit_offset"} % 8 ) / 8 );

    my @selected_bytes =
      @record[ $start_byte .. ( $start_byte + $length_byte - 1 ) ];

    # short cut
    if ( ( $cnblk{"signal_data_type"} >= 4 and $cnblk{"signal_data_type"} <= 6 )
        or $cnblk{"signal_data_type"} > 16 )
    {
        die "Unknown or obsoleted CN block Signal data type: ",
          $cnblk{"signal_data_type"};
    }

    # endian reverse
    if (
        ( $cnblk{"signal_data_type"} <= 3 and $byte_order == 0 )
        or (    $cnblk{"signal_data_type"} >= 13
            and $cnblk{"signal_data_type"} <= 16 )
      )
    {
        @selected_bytes = reverse @selected_bytes;
    }

    if (
        $cnblk{"signal_data_type"} == 0    # unsigned int
        or $cnblk{"signal_data_type"} == 9
        or $cnblk{"signal_data_type"} == 13
      )
    {
        return ( join_byte_number( \@selected_bytes )
              >> ( $cnblk{"bit_offset"} % 8 ) ) & ( 2**$cnblk{"n_bits"} - 1 );
    }
    elsif (
        $cnblk{"signal_data_type"} == 1    # signed int
        or $cnblk{"signal_data_type"} == 10
        or $cnblk{"signal_data_type"} == 14
      )
    {
        my $complement =
          ( join_byte_number( \@selected_bytes )
              >> ( $cnblk{"bit_offset"} % 8 ) ) & ( 2**$cnblk{"n_bits"} - 1 );
        my $high_symbol = $complement >> ( $cnblk{"n_bits"} - 1 );
        if ($high_symbol) {
            return ( ~$complement ) + 1;
        }
        else {
            return $complement;
        }

    }
    elsif (
        $cnblk{"signal_data_type"} == 2    # IEEE754 float 4bytes
        or $cnblk{"signal_data_type"} == 11
        or $cnblk{"signal_data_type"} == 15
      )
    {
        my $jn =
          ( join_byte_number( \@selected_bytes )
              >> ( $cnblk{"bit_offset"} % 8 ) ) & ( 2**$cnblk{"n_bits"} - 1 );
        return unpack( "f>", pack( "L>", $jn ) );
    }
    elsif (
        $cnblk{"signal_data_type"} == 3    # IEEE754 double 8bytes
        or $cnblk{"signal_data_type"} == 12
        or $cnblk{"signal_data_type"} == 16
      )
    {
        my $jn =
          ( join_byte_number( \@selected_bytes )
              >> ( $cnblk{"bit_offset"} % 8 ) ) & ( 2**$cnblk{"n_bits"} - 1 );
        return unpack( "d>", pack( "Q>", $jn ) );
    }
    elsif ( $cnblk{"signal_data_type"} == 7 )    # String (NULL terminated)
    {
        if (    $cnblk{"n_bits"} % 8 == 0
            and $cnblk{"bit_offset"} % 8 == 0 )
        {
            $selected_bytes[$#selected_bytes
              ]    # terminal ZERO will cause uninitialized warning of chr
              ? return join( "", map ( chr, @selected_bytes ) )
              : return join( "", map ( chr, @selected_bytes[ 0 .. -1 ] ) );
        }
        else {
            print STDERR "Unable to handle no-8-bits-byte string";
            return "";
        }
    }
    elsif ( $cnblk{"signal_data_type"} == 8 )    # Byte Array
    {
        return [@selected_bytes];
    }
    else {
        die "Unknown or obsoleted CN block Signal data type: ",
          $cnblk{"signal_data_type"};
    }

}

sub parse_records_of_cn {
    my ( $self, $cnblk_addr ) = @_;

    # my @records = @$records_of_cg;           # ((ptr_cg, record_id, record), )
    my %blks           = %{ $self->{"blks"} };
    my %cnblk          = %{ $blks{$cnblk_addr} };
    my $belong_cg_addr = $cnblk{"belong_cg_addr"};
    my @records = grep { $$_[0] eq $belong_cg_addr } @{ $self->{"records"} };

    my %ccblk;
    if ( defined $cnblk{"ptr_ccblk"} and $cnblk{"ptr_ccblk"} ) {
        %ccblk = %{ $blks{ $cnblk{"ptr_ccblk"} } };
    }

    my @datas;

    foreach (@records) {
        my @record = unpack( "C*", $$_[2] );
        my $d      = split_record_by_cn( \%cnblk, \@record );
        %ccblk ? $d = &{ $ccblk{"formula"} }($d) : 0;
        push @datas, $d;
    }

    return [@datas];
}

sub read_records_of_dg {
    my ( $self, $dgblk_addr ) = @_;
    my %blks    = %{ $self->{"blks"} };
    my $f       = $self->{"file_handler"};
    my @records = @{ $self->{"records"} };    # ((ptr_cg, record_id, record), )

    my %dgblk = %{ $blks{$dgblk_addr} };

    my %id2cg;                  # hash table: record id => cgblk addr
    my $n_records_of_dg = 0;    # number of records of a DG's data block

    my $cgblk_addr = $dgblk{"ptr_first_cgblk"};
    for ( my $i = 0 ; $i < $dgblk{"n_cgs"} ; $i++ ) {
        my %cgblk = %{ $blks{$cgblk_addr} };
        $id2cg{ $cgblk{"record_id"} } = $cgblk_addr;    # fill id2cg
        $n_records_of_dg += $cgblk{"n_records"};    # sum records number of dg
        $cgblk_addr = $cgblk{"ptr_next_cgblk"};
    }

    seek( $f, $dgblk{"ptr_dtblk"}, 0 );             # set data block start point

    my $buf;
    if ( $dgblk{"record_id_type"} eq 0 ) {    # no record id, [only one cg]
        my %cgblk = %{ $blks{ $dgblk{"ptr_first_cgblk"} } };
        for ( my $i = 0 ; $i < $cgblk{"n_records"} ; $i++ ) {
            read( $f, $buf, $cgblk{"sz_data_record"} );
            push @records,
              [ $dgblk{"ptr_first_cgblk"}, $cgblk{"record_id"}, $buf ];
        }
    }
    elsif ( $dgblk{"record_id_type"} eq 1 ) {    # prefix record id
        for ( my $i = 0 ; $i < $n_records_of_dg ; $i++ ) {
            read( $f, $buf, 1 );                 # UINT8
            my $record_id = unpack( "C", $buf );

            # print "- $record_id\n";
            my %cgblk = %{ $blks{ $id2cg{$record_id} } };
            read( $f, $buf, $cgblk{"sz_data_record"} );
            push @records, [ $id2cg{$record_id}, $cgblk{"record_id"}, $buf ];
        }
    }
    elsif ( $dgblk{"record_id_type"} eq 2 ) {    # prefix & suffix record id
        for ( my $i = 0 ; $i < $n_records_of_dg ; $i++ ) {
            read( $f, $buf, 1 );
            my $record_id = unpack( "C", $buf );
            my %cgblk     = %{ $blks{ $id2cg{$record_id} } };
            read( $f, $buf, $cgblk{"sz_data_record"} );
            push @records, [ $id2cg{$record_id}, $cgblk{"record_id"}, $buf ];
            read( $f, $buf, 1 );
        }
    }
    else {
        die "Unknown DG block record_id_type %d", $dgblk{"record_id_type"};
    }

    # foreach (@records) { print $$_[0]; print "\n"; }
    $self->{"records"} = [@records];
    return [@records];
}

sub read_a_blk {
    my ( $addr, $file_handler ) = @_;
    binmode($file_handler) or die "Unable to set bin mode!";
    seek $file_handler, $addr, 0;

    my ( $buf, $buf2 );

    read( $file_handler, $buf, 4 ) or die "$!";
    my ( $hdid, $blkl ) = block_header_parse($buf);
    unless ( "ID HD TX PR DG CG CN CC TR CD CE SR" =~ /$hdid/ ) {
        die "Unknown block: $hdid, length $blkl bytes.\n";
    }
    if ( $blkl <= 4 ) {
        die "Block too short, block: $hdid, length $blkl bytes.\n";
    }

    read( $file_handler, $buf2, $blkl - 4 )
      or die "Unable to read block body: $!";
    $buf = $buf . $buf2;

    if ( $hdid eq "HD" ) {
        return HD_block_parse($buf);
    }
    elsif ( $hdid eq "TX" ) {
        return TX_block_parse($buf);
    }
    elsif ( $hdid eq "PR" ) {
        return PR_block_parse($buf);
    }
    elsif ( $hdid eq "TR" ) {
        return TR_block_parse($buf);
    }
    elsif ( $hdid eq "DG" ) {
        return DG_block_parse($buf);
    }
    elsif ( $hdid eq "CG" ) {
        return CG_block_parse($buf);
    }
    elsif ( $hdid eq "CN" ) {
        return CN_block_parse($buf);
    }
    elsif ( $hdid eq "CC" ) {
        return CC_block_parse($buf);
    }
    else {
        print STDERR "Unable to handle block: $hdid, length $blkl bytes.\n";
        return undef;
    }
}

# ID, HD, DG, CG, CN
sub read_basic_blks {
    my ($file_handler) = @_;
    binmode($file_handler);

    my %blks;
    my ( $buf, $blk );

    read( $file_handler, $buf, 64 );
    $blk = ID_block_parse($buf);
    $blk ? $blks{0} = $blk : die "Unable to read ID block!";

    $blk = read_a_blk( 64, $file_handler );
    $blk ? $blks{64} = $blk : die "Unable to read HD block!";

    # DG
    my $dgblk_addr = ${ $blks{64} }{"ptr_dgblk"};
    while ($dgblk_addr) {
        my $blk = read_a_blk( $dgblk_addr, $file_handler );
        if ($blk) {
            $blks{$dgblk_addr} = $blk;

            # CG
            my $cgblk_addr = ${$blk}{"ptr_first_cgblk"};
            while ($cgblk_addr) {
                my $blk = read_a_blk( $cgblk_addr, $file_handler );
                if ($blk) {
                    $$blk{"belong_dg_addr"} = $dgblk_addr;
                    $blks{$cgblk_addr} = $blk;

                    # CN
                    my $cnblk_addr = ${$blk}{"ptr_first_cnblk"};
                    while ($cnblk_addr) {
                        my $blk = read_a_blk( $cnblk_addr, $file_handler );
                        if ($blk) {
                            $$blk{"cn_addr"}        = $cnblk_addr;
                            $$blk{"belong_cg_addr"} = $cgblk_addr;
                            $$blk{"belong_dg_addr"} = $dgblk_addr;
                            $blks{$cnblk_addr}      = $blk;

                            foreach (
                                (
                                    "ptr_ccblk",
                                    "ptr_txblk_long_name",
                                    "ptr_txblk_display_name"
                                )
                              )
                            {
                                my $addr = $$blk{$_};
                                $addr
                                  ? $blks{$addr} =
                                  read_a_blk( $addr, $file_handler )
                                  : print STDERR
                                  "Unable to read $_ block address $addr";
                            }
                        }
                        else {
                            die "Unable to read CN block at $cnblk_addr!";
                        }
                        $cnblk_addr = ${$blk}{"ptr_next_cnblk"};
                    }
                }
                else {
                    die "Unable to read CG block at $cgblk_addr!";
                }
                $cgblk_addr = ${$blk}{"ptr_next_cgblk"};
            }
        }
        else {
            die "Unable to read DG block at $dgblk_addr!";
        }
        $dgblk_addr = ${$blk}{"ptr_next_dgblk"};
    }

    return {%blks};
}

sub signal_name_list2cn_addrs {
    my ( $signal_name_list, $chnls ) = @_;
    my @signal_name_list = @$signal_name_list;
    my %chnls            = %$chnls;

    my @r = ();

    foreach my $name (@signal_name_list) {
        foreach ( values %chnls ) {
            if ( $$_{"signal_name"} eq $name ) {
                push @r, $$_{"cn_addr"};
                last;
            }
        }
    }
    return [@r];
}

sub gen_chnls {
    my ($blks) = @_;
    my %blks = %$blks;

    my %chnls;

    foreach ( keys %blks ) {
        if ( ${ $blks{$_} }{"blkid"} and ( ${ $blks{$_} }{"blkid"} eq "CN" ) ) {
            $chnls{$_} = $blks{$_};
        }
    }
    return {%chnls};
}

sub new {
    my ( $class, @args ) = @_;
    my $file_handler = shift @args;
    binmode($file_handler);

    my $self = {};

    $self->{"file_handler"} = $file_handler;
    $self->{"blks"}         = read_basic_blks($file_handler);
    $self->{"chnls"}        = gen_chnls( $self->{"blks"} );
    $self->{"records"}      = [];

    bless $self, $class;

    return $self;
}

1;
